home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-19
/
surfsrc3.zip
/
ANSICRT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-08-10
|
4KB
|
206 lines
{ Unit to implement most of the CRT functions using ANSI.SYS}
{ Some unsimulatable functions (normally input) are done using CRT unit }
unit ansicrt;
INTERFACE
uses CRT;
CONST
BW40 = 0; { 40x25 B/W on Color Adapter }
CO40 = 1; { 40x25 Color on Color Adapter }
BW80 = 2; { 80x25 B/W on Color Adapter }
CO80 = 3; { 80x25 Color on Color Adapter }
Mono = 7; { 80x25 on Monochrome Adapter }
Font8x8 = 256; { Add-in for ROM font }
{ Mode constants for 3.0 compatibility }
C40 = CO40;
C80 = CO80;
{ Foreground and Background color constants }
Black = 0;
Blue = 1;
Green = 2;
Cyan = 3;
Red = 4;
Magenta = 5;
Brown = 6;
LightGray = 7;
{ Foreground color constants }
DarkGray = 8;
Lightblue = 9;
LightGreen = 10;
LightCyan = 11;
LightRed = 12;
LightMagenta = 13;
Yellow = 14;
White = 15;
{ Add-in for blinking }
Blink = 128;
VAR
checkbreak : boolean; { Enable CTRL-BREAK }
CheckEOF : boolean; { Enable Ctrl-Z }
DirectVideo : Boolean; { Enable Direct Video Addressing}
CheckSnow : Boolean; { Enable snow filtering }
LastMode : Word; { Current Text Mode }
TextAttr : Byte; { Current Text Attribute }
WindMin : word; { Window upper left coordinates }
WindMax : word; { Window lower right coordinates }
SaveInt1b : Pointer; { Saved interrupt $1B }
Procedure AssignCrt (var F: Text);
Function keypressed : boolean;
Function Readkey : char;
Procedure Textmode (mode:word);
Procedure Window (X1,Y1,X2,Y2 : byte);
Procedure GotoXY(X,Y: Byte);
Function WhereX: Byte;
Function WhereY: Byte;
Procedure ClrScr;
Procedure ClrEol;
Procedure InsLine;
Procedure DelLine;
Procedure TextColor(color:byte);
Procedure TextBackground(Color: Byte);
Procedure LowVideo;
Procedure HighVideo;
Procedure NormVideo;
Procedure Delay(ms: Word);
Procedure Sound(Hz: Word);
Procedure NosSound;
IMPLEMENTATION
var
crtfil : text;
xoffset : byte;
yoffset : byte;
CONST
ESC = ^[;
{Emulated Functions}
Procedure GotoXY(X,Y: Byte);
begin
write(crtfil,ESC,'[',y+yoffset,';',x+xoffset,'H');
end;
Procedure Textmode (mode:word);
begin
write (crtfil,ESC,'[',mode,'h');
end;
Procedure ClrScr;
begin
write (crtfil,ESC,'[2J');
gotoxy (1,1);
end;
Procedure ClrEol;
begin
write (crtfil,ESC,'[K');
end;
Procedure TextColor(color:byte);
begin
if color > 7 then
write (crtfil,ESC,'[1;',color+30 - 8,'m')
else
write (crtfil,ESC,'[',color+30,'m');
end;
Procedure TextBackground(Color: Byte);
begin
write (crtfil,ESC,'[',color,'m');
end;
Procedure LowVideo;
begin
write (crtfil,ESC,'[0m');
end;
Procedure HighVideo;
begin
write (crtfil,ESC,'[1m');
end;
Procedure NormVideo;
begin
lowvideo
end;
{Unemulated functions}
Procedure AssignCrt (var F: Text);
begin
crt.assigncrt (f);
end;
Function keypressed : boolean;
begin
keypressed := crt.keypressed;
end;
Function Readkey : char;
begin
readkey := crt.readkey;
end;
Procedure Window (X1,Y1,X2,Y2 : byte);
begin
crt.window (x1,y1,x2,y2);
xoffset := x1 - 1;
yoffset := y1 - 1;
end;
Function WhereX: Byte;
begin
wherex := crt.wherex;
end;
Function WhereY: Byte;
begin
wherey := crt.wherey;
end;
Procedure InsLine;
begin
crt.insline;
end;
Procedure DelLine;
begin
crt.delLine;
end;
Procedure Delay(ms: Word);
begin
crt.delay(ms);
end;
Procedure Sound(Hz: Word);
begin
crt.sound(hz);
end;
Procedure NosSound;
begin
crt.nosound;
end;
begin
xoffset := 0;
yoffset := 0;
assign (crtfil,'');
rewrite (crtfil);
end.